home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
zindent7.zip
/
ZINDSK.INC
< prev
next >
Wrap
Text File
|
1987-03-30
|
10KB
|
356 lines
(***************************************************************)
(* *)
(* Include File of Procedures *)
(* System Disk Utility, v. 0830am, sun, 28.Mar.87, Glen Ellis *)
(* *)
(***************************************************************)
(* procedure *******************************************************)
(* Say File List, v. 0126pm, mon, 01.Sept.86, Glen Ellis *)
procedure pSayFileList;
(* display list of filenames from Text File input *)
begin
writeln;
FOR x := 1 to SysInSourceMax do
begin
writeln('SysInSource[',x,'] = ', SysInSource[x] );
end;
writeln;
end;
(* procedure **************************************************)
(* System Parse .inc, v. 0700pm, mon, 15.Dec.86, Glen Ellis *)
procedure pSysParse( parseFile : Thestr ; var PgmMod : string2 ;
var PgmModStrL, PgmModStrR : string2 );
(* SysInFilename contains the real SourceFileName *)
(* parse for ?TYP
(* OutLine(.TXT) / dBASE(.CMD.PRG) / Pascal(.PAS.INC.PRO.FUN)
(* default to .$$$ (which is written normally any way)
(* set SysMode flag to (' ') or (OL) or (TP) or (DB)
(*---------------------------------------------------------*)
(* parseFile = parseFileName to be parsed for .TYP mode
(* Mode = flag for system use
(* ModStrL = prefix for comment line
(* ModStrR = Suffix for comment line
*)
var
i : nbr;
uTYPArray : array[0..12] of string4;
uTYPe : string4;
uLine : THEstr;
begin (* proc *)
uType := ' ';
(* enter only if SysPgmMod is ' ' *)
(* pgmMod := ' '; *)
PgmModStrL := ' ';
PgmModStrR := ' ';
(* OutLine *)
uTYPArray[0] := '.TXT';
(* dBASE *)
uTYPArray[1] := '.CMD';
uTYPArray[2] := '.PRG';
(* Turbo Pascal *)
uTYPArray[3] := '.PAS';
uTYPArray[4] := '.INC';
uTYPArray[5] := '.FUN';
uTYPArray[6] := '.PRO';
uTYPArray[7] := '.BOX';
(* ZinLine,ZinFile, and ZinUser also trap for this error. *)
IF length(parseFile) = 0 then
begin
writeln('No FileName Entered');
pAlarm;
pKeyPressed;
end;
(*-------------------*)
pAllCaps(parseFile); (* prep for parse for filename *)
x := pos('.',parseFile);
IF x < 1 then (* emergency trap *)
begin
parseFile := '.###';
x := 1;
end;
uTYPe := copy(parseFile,x,4);
uLine := uTYPe;
pAllCaps(uLine);
(*------*)
(* OutLine , general catch-all *)
(* KeyWord parser procedure has not neen written for OutLine. *)
(* potential use is for Assembler Source Code. *)
(* for x := y to z do *)
begin
IF uTYPe = uTYPArray[0] then
(* there is no key.inc module for this. User can write one *)
begin
PgmMod := 'OL';
PgmModStrL := '; '; (* comment delimiters *)
PgmModStrR := ' ;';
end;
end;
for x := 1 to 2 do
begin
(* dBASE *)
IF uTYPe = uTYPArray[x] then
begin
PgmMod := 'DB';
PgmModStrL := '* '; (* comment delimiters *)
PgmModStrR := ' *';
end;
end;
(* Turbo Pascal *)
for x := 3 to 7 do
begin
IF uTYPe = uTYPArray[x] then
begin
PgmMod := 'TP';
PgmModStrL := '(*'; (* comment delimiters *)
PgmModStrR := '*)';
end;
end;
end; (* proc *)
(* procedure ************************************************************)
(* Input/Output Error Checking, v. 0700pm, sun, 21.Sept.86, Glen Ellis *)
procedure pIOCheck( var IOcheck : lgc );
(* develop no halt for trying to read non-existent file *)
(* need skip read loop, continue program if no file found *)
var
Ch : Char;
IOReadErr : lgc;
begin (* proc *)
IOVal := IOresult;
IOErr := (IOVal <> 0);
(* GotoXY(1,23); ClrEol; *)
IF IOErr then
begin
Write(Chr(7));
writeln('---------------------------');
writeln(' I/O Error ');
writeln('---------------------------');
(* pAlarm; (* SysUtl.inc *)
CASE IOVal of
$01 : Write(' File does not exist');
$02 : Write(' File not open for input');
$03 : Write(' File not open for output');
$04 : Write(' File not open');
$05 : Write(' Can''t read from this file');
$06 : Write(' Can''t write to this file');
$10 : Write(' Error in numeric format');
$20 : Write(' Operation not allowed on a logical device');
$21 : Write(' Not allowed in direct mode');
$22 : Write(' Assign to standard files not allowed');
$90 : Write(' Record length mismatch');
$91 : Write(' Seek beyond end of file');
$96 : Write(' Strange undefined IO error, not in manual !');
$99 : Write(' Unexpected end of file');
$F0 : Write(' Disk write error');
$F1 : Write(' Directory is full');
$F2 : Write(' File size overflow');
$FF : Write(' File disappeared')
else Write(' Unknown I/O error: ',IOVal:3)
end; (* case *)
writeln;
(* if no read file, then skip whole "core" loop *)
(* this is probably NOT a FATAL error. *)
IF IOval = $01 then
begin
(* IOcheck is tested/prompted in main program *)
IOcheck := false ;
IF SysPgmTrace then
begin
(* inform the user, and keep going *)
writeln(' IOcheck = ',IOcheck,' : IOval = ',IOval,chr(7));
pDelay4;
end;
end;
(* other errors May Be Fatal, so allow user to exit *)
IF IOval > $01 then (**)
begin
Repeat
Read(Kbd,Ch)
Until Not KeyPressed;
writeln(' User Interrupt allowed ');
Write(^M,' Terminate (Y/N)? ');
Read(Kbd,Ch);
IF UpCase(Ch)='Y' Then
begin
WriteLn('Y');
(* Write(SysOutFile,' User Terminated on pIOcheck error');*)
Close(SysOutFile);
Close(SysInFile);
Halt;
end
Else Write(^M,' ',^M);
end; (* IOval *)
end; (* IOerr *)
end; (* proc *)
(* procedure ****************************************************)
(* Start System Files, v. 0752pm, thu, 18.Sep.86, Glen Ellis *)
procedure pSysStartFiles( var IOcheck : lgc );
(* borrows system global vars *)
(* SysFile 0,1,2, SysIOcheck flag*)
var
x : integer;
begin (* proc *)
(* position of .typ *)
x := pos('.',SysInFileName);
(* file.BAK *)
SysFile0 := copy(SysInFileName,1,x);
SysFile0 := concat(SysFile0,'BAK');
(* file.CMD *)
SysFile1 := SysInFileName;
(* file.$$$ *)
SysFile2 := copy(SysInFileName,1,x);
SysFile2 := concat(SysFile2,'$$$');
IF SysUserTrace then
begin
pSaySysFiles; (* SysUtl.inc *)
IF SysPgmTrace then pDelay1;
end;
IF SysUserTrace then writeln(' Assign Read-File = ',SysFile1);
ASSIGN( SysInFile, SysFile1 );
IF SysUserTrace then writeln(' Reset Read = ',SysFile1);
(*$I-*); RESET( SysInFile ); (*$I+*);
pIOcheck( IOcheck );
IF IOcheck then (* able to read from Source file *)
begin
IF SysUserTrace then writeln(' Assign Write-File = ',SysFile2);
ASSIGN( SysOutFile, SysFile2 );
IF SysUserTrace then writeln(' ReWrite Write = ',SysFile2);
(*$I-*); REWRITE( SysOutFile ); (*$I+*);
pIOcheck( IOcheck );
end; (* IOcheck *)
end; (* proc *)
(* Procedure *********************************************************)
(* Rename System Files, v. 0830pm, wed, 17.Sep.86, Glen Ellis *)
procedure pSysReName( var IOcheck : lgc );
begin (* proc *)
(* borrows syste